home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / delphi.swg / 0176_Floating toolbar with no title bar.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-30  |  4.3 KB  |  185 lines
  1.  
  2. Someone asked for some code to make a form with no title bar moveable, kind of like a
  3. floating toolbar, for example FreeDock. Actually, for some of the stuff in here I
  4. spied on the FreeDock sources...
  5.  
  6. This requires the use of some WinAPI functions. All WinAPI functions are however
  7. available at a touch of a key (F1 - OnLine Help)...
  8.  
  9. Here's some code that does this (about 100 lines)...
  10.  
  11. To make this work like intended:
  12.  
  13. Cut out the DFM, DPR and PAS files below :
  14.  
  15. unit Unit1;
  16.  
  17. interface
  18.  
  19. uses
  20.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  21.   Forms, Dialogs, ExtCtrls, StdCtrls;
  22.  
  23. type
  24.   TForm1 = class(TForm)
  25.     Panel1: TPanel;
  26.     Panel2: TPanel;
  27.     Button1: TButton;
  28.     procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  29.       Shift: TShiftState; X, Y: Integer);
  30.     procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  31.       Y: Integer);
  32.     procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  33.       Shift: TShiftState; X, Y: Integer);
  34.     procedure Button1Click(Sender: TObject);
  35.   private
  36.     { Private declarations }
  37.     OldX,
  38.     OldY,
  39.     OldLeft,
  40.     OldTop   : Integer;
  41.     ScreenDC : HDC;
  42.     MoveRect : TRect;
  43.     Moving   : Boolean;
  44.   public
  45.     { Public declarations }
  46.   end;
  47.  
  48. var
  49.   Form1: TForm1;
  50.  
  51. implementation
  52.  
  53. {$R *.DFM}
  54.  
  55. procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  56.   Shift: TShiftState; X, Y: Integer);
  57. begin
  58.   if Button = mbLeft then begin
  59.     SetCapture(Panel1.Handle);
  60.     ScreenDC := GetDC(0);
  61.     OldX := X;
  62.     OldY := Y;
  63.     OldLeft := X;
  64.     OldTop := Y;
  65.     MoveRect := BoundsRect;
  66.     DrawFocusRect(ScreenDC,MoveRect);
  67.     Moving := True;
  68.   end;
  69. end;
  70.  
  71. procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  72.   Y: Integer);
  73. begin
  74.   if Moving then begin
  75.     DrawFocusRect(ScreenDC,MoveRect);
  76.     OldX := X;
  77.     OldY := Y;
  78.     MoveRect := Rect(Left+OldX-OldLeft,Top+OldY-OldTop,
  79.                      Left+Width+OldX-OldLeft,Top+Height+OldY-OldTop);
  80.     DrawFocusRect(ScreenDC,MoveRect);
  81.   end;
  82. end;
  83.  
  84. procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  85.   Shift: TShiftState; X, Y: Integer);
  86. begin
  87.   if Button = mbLeft then begin
  88.     ReleaseCapture;
  89.     DrawFocusRect(ScreenDC,MoveRect);
  90.     Left := Left+X-OldLeft;
  91.     Top := Top+Y-OldTop;
  92.     ReleaseDC(0,ScreenDC);
  93.     Moving := False;
  94.   end;
  95. end;
  96.  
  97. procedure TForm1.Button1Click(Sender: TObject);
  98. var
  99.   TitleHeight,
  100.   BorderWidth,
  101.   BorderHeight : Integer;
  102. begin
  103.   TitleHeight := GetSystemMetrics(SM_CYCAPTION);
  104.   BorderWidth := GetSystemMetrics(SM_CXBORDER)+GetSystemMetrics(SM_CXFRAME)-1;
  105.   BorderHeight := GetSystemMetrics(SM_CYBORDER)+GetSystemMetrics(SM_CYFRAME)-2;
  106.   if BorderStyle = bsNone then begin
  107.     BorderStyle := bsSizeable;
  108.     Top := Top-TitleHeight-BorderHeight;
  109.     Height := Height+TitleHeight+2*BorderHeight;
  110.     Left := Left-BorderWidth;
  111.     Width := Width+2*BorderWidth;
  112.   end
  113.   else begin
  114.     BorderStyle := bsNone;
  115.     Top := Top+TitleHeight+BorderHeight;
  116.     Height := Height-TitleHeight-2*BorderHeight;
  117.     Left := Left+BorderWidth;
  118.     Width := Width-2*BorderWidth;
  119.   end;
  120. end;
  121.  
  122. end.
  123.  
  124. { DFM FILE - form file}
  125.  
  126. object Form1: TForm1
  127.   Left = 245
  128.   Top = 137
  129.   BorderStyle = bsNone
  130.   Caption = 'Form1'
  131.   ClientHeight = 101
  132.   ClientWidth = 198
  133.   Font.Color = clWindowText
  134.   Font.Height = -11
  135.   Font.Name = 'MS Sans Serif'
  136.   Font.Style = []
  137.   PixelsPerInch = 96
  138.   TextHeight = 13
  139.   object Panel1: TPanel
  140.     Left = 8
  141.     Top = 8
  142.     Width = 185
  143.     Height = 41
  144.     BorderStyle = bsSingle
  145.     Caption = 'Panel1'
  146.     TabOrder = 0
  147.     OnMouseDown = Panel1MouseDown
  148.     OnMouseMove = Panel1MouseMove
  149.     OnMouseUp = Panel1MouseUp
  150.   end
  151.   object Panel2: TPanel
  152.     Left = 8
  153.     Top = 56
  154.     Width = 185
  155.     Height = 41
  156.     Caption = 'Come Caption'
  157.     TabOrder = 1
  158.     object Button1: TButton
  159.       Left = 52
  160.       Top = 8
  161.       Width = 87
  162.       Height = 25
  163.       Caption = 'Toggle Title Bar'
  164.       TabOrder = 0
  165.       OnClick = Button1Click
  166.     end
  167.   end
  168. end
  169.  
  170. { DPR FILE }
  171.  
  172. program Project1;
  173.  
  174. uses
  175.   Forms,
  176.   Unit1 in 'Unit1.pas' {Form1};
  177.  
  178. {$R *.RES}
  179.  
  180. begin
  181.   Application.Initialize;
  182.   Application.CreateForm(TForm1, Form1);
  183.   Application.Run;
  184. end.
  185.